home *** CD-ROM | disk | FTP | other *** search
/ Netware Super Library / Netware Super Library.iso / pgm_tool / nwtp06 / fsend.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-01  |  7.6 KB  |  255 lines
  1. {$X+,V-,B-,I-}
  2. program Fsend; { Master / Sender }
  3.  
  4. { Testprogram for the nwPEP unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
  5.  
  6. {$DEFINE noTRACE}
  7.  
  8. uses dos,crt,nwMisc,nwBindry,nwConn,nwIPX,nwPEP;
  9.  
  10. CONST IOSocket=$5678;           { socket to transmit/receive on }
  11.  
  12. Var ListenECB     :Tecb;        { ECB and header, to listen for acknowledgement }
  13.     ListenPepHdr  :TpepHeader;
  14.  
  15.     SendECB       :Tecb;        { ECB and header, used to send the data }
  16.     SendPepHdr    :TpepHeader;
  17.  
  18.     socket        :word;
  19.  
  20.     SendDataBuffer  :array[1..546] of byte; { SendDataBufferfer for data to be sent }
  21.  
  22.     ListenDataBuffer:array[1..8] of byte;
  23.  
  24.     AckReceived   :boolean;     { set to true within the ListenForAckESR }
  25.  
  26.     SendTransId   :LongInt;     { transactionID. This uniquely identifies
  27.                                   the packet. The slave/receiver has to
  28.                                   reply with the same transactionID in the
  29.                                   header of the acknowledgement. Only if
  30.                                   this number is the same as the transactioID
  31.                                   of the sent packet, the pavket is considered
  32.                                   successfully delivered. }
  33.  
  34.     NewStack:array[1..1024] of word;  { !! used by ESR }
  35.     StackBottom:word;                 { !! used by ESR }
  36.  
  37.     f:file;
  38.  
  39.  
  40. Procedure CheckError(err:boolean; errNbr:word);
  41. begin
  42. if err
  43.  then begin
  44.       writeln;
  45.       CASE errNbr of
  46.        $0100:writeln('IPX needs to be installed.');
  47.        $0200:writeln('Error: can''t locate the spcified username.');
  48.        $0201:begin
  49.               writeln('The specified user has multiple connections.');
  50.               writeln('This demonstation program doesn''t support multiple connections.');
  51.               end;
  52.        $0202:writeln('Error: can''t find the address of the supplied username.');
  53.        $0204:writeln('Transfer aborted after 50 retries.');
  54.        $0205:writeln('Key pressed: Transfer aborted.');
  55.        $0206:writeln('The supplied file couldn''t be found. Please supply full path.');
  56.        $0300:writeln('Error reading file.');
  57.        $10FE:writeln('Error opening socket: Socket Table Is Full.');
  58.        $10FF:writeln('Error opening socket: Socket is already open.');
  59.       end; {case}
  60.       IPXcloseSocket(IOsocket);
  61.       close(f);
  62.       halt(1);
  63.       end;
  64. end;
  65.  
  66. Function TimeOut(t1,t2:word;n:byte):boolean;
  67. { ticks t2 - ticks t1 > n seconds ? }
  68. Var lt1,lt2:LongInt;
  69. begin
  70. lt2:=t2;
  71. if t1>t2 then lt2:=lt2+$FFFF;
  72. TimeOut:=(lt2-t1)>(n*18);
  73. end;
  74.  
  75.  
  76. {$F+}
  77. Procedure ListenForAckHandler(Var p:TPecb);
  78.  { Interrupts are turned off -and should remain turned off- }
  79. begin
  80. IF (ListenECB.CompletionCode<>0)                      { packet must be suucessfully received.. }
  81.  or (ListenPepHdr.IPXhdr.packetType<>PEP_PACKET_TYPE) { of type PEP.. }
  82.  or (ListenPepHdr.ClientType<>$EA)                    { of client type $EA }
  83.  or (ListenPepHdr.TransactionID<>SendTransId)         { with a correct clientID (of the packet the master sent) }
  84.   then IPXListenForPacket(ListenECB)   { Invalid packet => listen again   }
  85.   else AckReceived:=true;              { valid packet   => ACK received ! }
  86. end;
  87. {$F-}
  88.  
  89. {$F+}
  90. Procedure ListenForAckESR; assembler;
  91. asm { ES:SI are the only valid registers when entering this procedure ! }
  92.     { interrupts are turned off -and should remain turned off- }
  93.     mov dx, seg stackbottom
  94.     mov ds, dx
  95.  
  96.     mov dx,ss  { setup of a new local stack }
  97.     mov bx,sp  { ss:sp copied to dx:bx}
  98.     mov ax,ds
  99.     mov ss,ax
  100.     mov sp,offset stackbottom
  101.     push dx    { push old ss:sp on new stack }
  102.     push bx
  103.  
  104.     push es    { push es:si on stack as local vars }
  105.     push si
  106.     mov  di,sp
  107.  
  108.     push ss    { push address of local ptr on stack }
  109.     push di
  110.     CALL ListenForAckHandler
  111.  
  112.     add sp,4   { skip stack ptr-copy }
  113.     pop bx     { restore ss:sp from new stack }
  114.     pop dx
  115.     mov sp,bx
  116.     mov ss,dx
  117. end;
  118. {$F-}
  119.  
  120.  
  121. Var dest:TinternetworkAddress;
  122.     ticks,ticks2:word;
  123.     retries     :word;
  124.  
  125.     Uname,Fname:string;
  126.     NbrOfConn:byte;
  127.     connList:TconnectionList;
  128.  
  129.     p:byte;
  130.     FileInfo:searchrec;
  131.     FileSize:LongInt;
  132.     BytesRead:word;
  133.  
  134.     TransferStartTicks,TransferEndTicks:word;
  135.     OriginalFileSize:LongInt;
  136.  
  137. begin
  138. If paramcount<>2
  139.  then begin
  140.       writeln('Usage: FSEND <username> <filename>');
  141.       writeln('-The file will be sent to the workstation of the supplied username.');
  142.       writeln('-Run FGET on that workstation to receive the file.');
  143.       halt(1);
  144.       end;
  145. Uname:=ParamStr(1);
  146. UpString(Uname);
  147. NbrOfConn:=0;
  148. GetObjectConnectionNumbers(Uname,OT_USER,NbrOfConn,connList);
  149. CheckError((nwConn.result>0) or (NbrOfConn=0),$200);
  150. CheckError(NbrOfConn>1,$0201);
  151.  
  152. GetInternetAddress(connList[1],dest);
  153. CheckError(nwconn.result>0,$0202);
  154. dest.socket:=IOsocket;
  155.  
  156. Fname:=ParamStr(2);
  157. Assign(f,Fname);
  158. Reset(f,1);
  159. CheckError(IOresult<>0,$0206);
  160.  
  161.  
  162. IpxInitialize;
  163. CheckError(nwIPX.result>0,$0100);
  164.  
  165. socket:=IOSocket;
  166. IPXopenSocket(Socket,SHORT_LIVED_SOCKET);
  167. CheckError(nwIPX.result>0,$1000+nwIPX.result);
  168.  
  169. { setup listening for ack }
  170. AckReceived:=False;
  171.  
  172. PEPsetupListenECB(Addr(ListenForAckESR),IOsocket,@ListenDataBuffer,8,
  173.                   ListenPepHdr,ListenECB);
  174. IPXListenForPacket(ListenECB);
  175.  
  176. { send initial packet with the name and size of the file to be sent. }
  177. findfirst(Fname,$FF,FileInfo);
  178. Move(FileInfo.size,SendDataBuffer[16],4);
  179. FileSize:=Fileinfo.size;
  180. p:=length(Fname);
  181. while (p>0) and (Fname[p]<>':') and (Fname[p]<>'\')
  182.  do dec(p);
  183. If p>0
  184.  then delete (Fname,1,p);
  185. Move(Fname[0],SendDataBuffer[1],15);
  186.  
  187. PEPsetupSendECB(NIL,IOsocket,dest,@SendDataBuffer[1],512,
  188.                 SendPepHdr,SendECB);
  189. SendTransID:=1;
  190. SendPepHdr.ClientType:=$EA;
  191.  
  192. OriginalFileSize:=FileSize;
  193. FileSize:=FileSize+512; { compensate length for information header }
  194.  
  195. writeln('FSEND waiting for remote handshake. (any key to abort)');
  196.  
  197. While Filesize>0
  198.  do begin
  199.     ackreceived:=false;
  200.     SendPepHdr.TransactionId:=SendTransId;
  201.     IPXsendPacket(SendECB);
  202.     {$IFDEF TRACE}
  203.     write('Packet#',SendTransID,' sent.');
  204.     {$ENDIF}
  205.     while sendECB.InuseFlag<>0
  206.      do IPXrelinquishControl;
  207.  
  208.     IPXGetIntervalMarker(ticks);
  209.     retries:=0;
  210.     REPEAT
  211.       IPXrelinquishcontrol;
  212.       IPXGetIntervalMarker(ticks2);
  213.       if (ticks2-ticks)>2
  214.        then begin
  215.             inc(retries);
  216.             {$IFDEF TRACE}
  217.             writeln;
  218.             write('Timeout: resending packet#',SendTransID);
  219.             {$ENDIF}
  220.             IPXsendPacket(SendECB);
  221.             while sendECB.InuseFlag<>0
  222.              do IPXrelinquishControl;
  223.             IPXGetIntervalMarker(ticks);
  224.             end;
  225.       CheckError(retries>50,$0204);
  226.       CheckError(Keypressed,$0205);
  227.     UNTIL AckReceived;
  228.     if SendTransID=1
  229.      then begin
  230.           writeln('Handshake received. Starting file transfer.');
  231.           IPXGetIntervalMarker(TransferStartTicks);
  232.           end;
  233.     {$IFDEF TRACE}
  234.     writeln(' Ackn.#',ListenPepHdr.TransactionID,' received.');
  235.     {$ENDIF}
  236.     FileSize:=FileSize-512;
  237.  
  238.     { fill buffer with next block of data }
  239.     IF FileSize>0
  240.      then begin
  241.           BlockRead(f,SendDataBuffer,512,bytesread);
  242.           CheckError((bytesread<512) and (filesize<>bytesread),$0300);
  243.           end;
  244.  
  245.     inc(SendTransID);
  246.     IPXListenForPacket(ListenECB); { start listening for acks again }
  247.     end;
  248. IPXGetIntervalMarker(TransferEndTicks);
  249. IPXcancelEvent(ListenECB);
  250. Writeln('Transfer completed.');
  251. writeln('Throughput: ', 18*OriginalFileSize/(TransferEndTicks-TransferStartTicks):4:2,' bps');
  252. IPXcloseSocket(IOsocket);
  253. close(f);
  254.  
  255. end.